module Data.Graph.Traversal where

import Data.Graph.Basics 
import Data.Set hiding (map)
import Control.Monad.State

 -----------------------------------------------------------------------------
-- | Traversal (under construction)

dfs r
  = dfsFrom r [] (elems $ ent r)
    

dfsFrom r stop []
  = []
dfsFrom r stop (n:ns)
  | n `elem` stop
  = dfsFrom r stop ns
  | otherwise
  = fromKids++(n:(dfsFrom r stop'' ns))
    where
      kids = [ y | (x,y) <- elems r, x==n ]
      stop' = n:stop
      fromKids = dfsFrom r stop' kids
      stop'' = stop'++fromKids
      
dfsFrom' r (stop,(n:ns))
  | n `elem` stop
  = dfsFrom' r (stop,ns)
  | otherwise
  = (stop''',fromKids++(n:fromRest))
    where
      kids = [ y | (x,y) <- elems r, x==n ]
      stop' = n:stop
      (stop'',fromKids)  = dfsFrom' r (stop',kids)
      (stop''',fromRest) = dfsFrom' r (stop'',ns)
dfsFrom' r (stop,[])
  = (stop,[])
            
dfs' r
  = snd $ dfsFrom' r ([],(elems $ ent r))
   
dfsS r
  = evalState (dfsState r) ([],elems $ ent r)
dfsState r  = do
  (stop,ns) <- get
  case ns of
    (n:ns)
      -> if (n `elem` stop)
          then do
            put (stop,ns)
            dfsState r
          else do
            let kids = [ y | (x,y) <- elems r, x==n ]
            put (n:stop,kids)
            fromKids <- dfsState r
            (stop,_) <- get
            put (stop,ns)
            fromRest <- dfsState r
            return (fromKids++(n:fromRest))
    []
      -> return ns

dfsT r
  = evalState (dfsStateT r) ([],elems $ ent r,emptyRel)
dfsStateT r  = do
  (stop,ns,t) <- get
  case ns of
    (n:ns)
      -> if (n `elem` stop)
          then do
            put (stop,ns,t)
            dfsStateT r
          else do
            let entT = ent t
            let edges = [ (x,y) | (x,y) <- elems r, 
                                  x==n, not (y `member` entT) ]
            let kids = map snd edges
            put (n:stop,kids,t `union` (mkRel edges))
            dfsStateT r
            (stop,_,t) <- get
            put (stop,ns,t)
            dfsStateT r
    []
      -> return t



